home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / ENTRY.SWG / 0017_Input Routine.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  7KB  |  251 lines
  1. { Version 1.5 of...
  2.   Yet Another, Quite General Input Routine (YA-QGIR, pronounced YA-QJUGEER)
  3.   --------------------------------------------------------------------------
  4.   This one is (C)1993,1994 Eddy Jansson, P.I - No Rights Reserved.
  5.   The following routines may be used in your own programs, as long as
  6.   you promise to modify them to meet your own needs.
  7.  
  8.   Ofcourse I take *NO* responsability for any injuries inflicted on man
  9.   or animal or cause of dataloss from these routines. These routines
  10.   may NOT be used in whole, or in part, in any life supporting, nuclear
  11.   or weapon related systems.
  12.  
  13.  // Eddy Jansson    FidoNet: 2:206/406
  14.                    InterNet: eddy.jansson@haricot.ct.se
  15.  
  16. Usage of the Input Routine:
  17.  
  18. Function Input(X,Y: Byte;StartStr,BackG,PassChar: String;MaxLen,StartPos:
  19.                Integer;AcceptSet: CharSet;Ins: Boolean;var InputStatus: Byte):
  20. String;
  21. X,Y         Where on screen to put the input.
  22. StartStr    Default input string.
  23. BackG       Background Character, eg ' ' or '░' etc.
  24. PassChar    If defined this character will be displyed instead of the input
  25. stream.MaxLen      MaxLen of Input.
  26. StartPos    Where in input string to place the cursor, -1 = End of StartStr
  27. AcceptSet   Which characters should be accepted as input, often [#32..#255]
  28.             NOTE: if you include #8 in this mask, you cannot use delete.
  29. Ins         Begin in INSERT or OVERWRITE mode (Boolean)
  30. InputStatus Upon exit from the input routine this variable will hold:
  31.             13 = Input terminated with Enter.
  32.             27 = Input terminated with ESC.
  33.             72 = User pressed UpArrow
  34.             80 = User pressed DownArrow
  35.             73 = User pressed Page Up
  36.             81 = User pressed Page Down
  37.             etc...
  38.  
  39.  Next Version: Window (ie; edit 255 chars in a 16 char window)
  40.                ExitChar Mask
  41. }
  42.  
  43. Uses Crt;
  44.  
  45. type
  46.  CharSet = Set of #0..#255; { This MUST be present for the routine to work }
  47.  
  48. var
  49.  S      :String[80];
  50.  IS     :Byte;
  51.  
  52. { ------ START OF GENERAL ROUTINES ------ }
  53.  
  54. Function Left(s: String;nr: byte): String;
  55. begin
  56.  Delete(s,nr+1,length(s));
  57.  Left:=s;
  58. end;
  59.  
  60. Function Mid(s: String;nr,nr2: byte): String;
  61. begin
  62.  Delete(s,1,nr-1);
  63.  Delete(s,nr2+1,length(s));
  64.  Mid:=s;
  65. end;
  66.  
  67. Procedure WriteXY(x,y: Byte;s: String);
  68. var
  69. loop:   Word;
  70. begin (* This can be _higly_ optimized *)
  71.  for loop:=x to x+length(s)-1 do
  72. Mem[$B800:(loop-1)*2+(y-1)*160]:=Ord(S[loop-x+1]);end;
  73.  
  74. Function RepeatChar(s: String;antal: byte): String;
  75. var
  76.  temp: String;
  77. begin
  78. temp:=s[1];
  79.  While Length(temp)<Antal do Insert(s[1],temp,1);
  80. RepeatChar:=Temp;
  81. end;
  82.  
  83. Procedure NormalCursor; Assembler;
  84. asm
  85.  mov ah,1
  86.  mov ch,6
  87.  mov cl,7
  88.  int $10
  89. end;
  90.  
  91. Procedure BlockCursor; Assembler;
  92. asm
  93.  mov ah,1
  94.  mov ch,0
  95.  mov cl,7
  96.  int $10
  97. end;
  98.  
  99. { ------ END OF GENERAL ROUTINES ------ }
  100.  
  101. Function Input(X,Y: Byte;StartStr,BackG,PassChar: String;MaxLen,StartPos:
  102.                Integer;AcceptSet: CharSet;Ins: Boolean;var InputStatus: Byte):
  103. String;{Version 1.5}
  104. Var
  105. P         :Byte;
  106. Exit      :Boolean;
  107. ch        :Char;
  108. ext       :Char;
  109. s         :String;
  110. t         :String[1];
  111.  
  112. begin
  113. Exit:=False;                                      { Don't quit on me yet! }
  114. if Length(PassChar)>1 then PassChar:=PassChar[1]; { Just in Case... ;-) }
  115. if Length(BackG)>1 then BackG:=BackG[1];
  116. if Length(BackG)=0 then BackG:=' ';
  117. if Length(StartStr)>MaxLen then StartStr:=Left(StartStr,MaxLen);
  118. if StartPos>Length(StartStr) then StartPos:=Length(StartStr);
  119. if StartPos=-1 then StartPos:=Length(StartStr);
  120. If StartPos>=MaxLen then StartPos:=MaxLen-1;
  121.  
  122. s:=StartStr;                                { Put StartStr into Edit Buffer }
  123. WriteXY(X,Y,RepeatChar(BackG,MaxLen));
  124.  
  125. if StartStr<>'' then begin
  126. if passchar='' then WriteXY(X,Y,StartStr) else
  127.                     WriteXY(X,Y,RepeatChar(PassChar,Length(StartStr)));
  128. end;
  129.  
  130. p:=StartPos;
  131. GotoXY(X+StartPos,Y);
  132.  
  133. repeat
  134.  if Ins then NormalCursor else BlockCursor;
  135.  ext:=#0;
  136.  ch:=ReadKey;
  137.  if ch=#0 then ext:=ReadKey;
  138.  if ch=#27 then begin
  139.                  InputStatus:=27;
  140.                  Exit:=True;
  141.                 end;
  142. {   (ch<#255) and (ch>#31) }
  143. if ch in AcceptSet then
  144.  begin   { Welcome to the jungle...}
  145.   t:=ch;
  146.    if (p=length(s)) and (Length(s)<MaxLen) then
  147.     begin
  148.      s:=s+t;
  149.      if PassChar='' then WriteXY(X+P,Y,T) else WriteXY(X+P,Y,PassChar);
  150.      Inc(p);
  151.     end else
  152.      if length(s)<MaxLen then begin
  153.       if Ins then Insert(T,S,P+1) else s[p+1]:=Ch;
  154.       if PassChar='' then WriteXY(X+P,Y,Copy(S,P+1,Length(S))) else
  155. WriteXY(X+Length(S)-1,Y,PassChar);      Inc(p);
  156.      end else if (Length(s)=MaxLen) and (not Ins) then
  157.       begin
  158.        s[p+1]:=ch;
  159.        if PassChar='' then WriteXY(X+P,Y,T) else WriteXY(X+P,Y,PassChar);
  160.        Inc(p);
  161.       end;
  162.    ch:=#0;
  163.    if p>MaxLen-1 then p:=MaxLen-1;
  164.    GotoXY(X+P,Y);
  165.   end else begin
  166.  
  167.  case ch of { CTRL-Y }
  168.   #25:   begin
  169.           WriteXY(X,Y,RepeatChar(BackG,Length(S)));
  170.           P:=0;
  171.           S:='';
  172.           GotoXY(X,Y);
  173.          end;
  174.  
  175.  {Backspace}
  176.  #8: If (P>0) then
  177.   begin
  178.    if (p+1=MaxLen) and (p<length(s)) then Ext:=#83 else
  179.     begin
  180.      Delete(S,P,1);
  181.      Dec(P);
  182.      GotoXY(X+P,Y);
  183.       if PassChar='' then WriteXY(X+P,Y,Copy(S,P+1,Length(s))+BackG) else
  184.        if P>0 then WriteXY(X+Length(s)-1,Y,PassChar+BackG) else
  185.         WriteXY(X+Length(s),Y,BackG);
  186.     end;
  187.   end;
  188.  
  189.   #9: begin { Exit on TAB }
  190.        InputStatus:=9;
  191.        Exit:=True;
  192.       end;
  193.  
  194.  #13: begin
  195.        InputStatus:=13;
  196.        Exit:=True;
  197.       end;
  198.  end; { Case CH of }
  199.  
  200.  case ext of
  201.  #75: if P>0 then begin
  202.  {Left Arrow}      Dec(P);
  203.                    GotoXY(X+P,Y);
  204.                   end;
  205.  
  206.  #77: if (P<Length(s)) and (P+1<MaxLen) then begin
  207.  {Right Arrow}             Inc(P);
  208.                            GotoXY(X+P,Y);
  209.                           end;
  210.  
  211.  #82: Ins:=Not(Ins); {Insert}
  212.  {Delete}
  213.  #83: If P<Length(s) then
  214.   begin
  215.    Delete(S,P+1,1);
  216.     if PassChar='' then WriteXY(X+P,Y,Copy(S,P+1,Length(s))+BackG) else
  217.      if p>0 then WriteXY(X+Length(S)-1,Y,PassChar+BackG) else
  218.       WriteXY(X+Length(S),Y,BackG);
  219.    end;
  220.  
  221.  #71: begin
  222.        p:=0;
  223.        GotoXY(X+P,Y);
  224.       end;
  225.  
  226.  #79: begin
  227.        p:=Length(s);
  228.        if p>=MaxLen then P:=MaxLen-1;
  229.        GotoXY(X+P,Y);
  230.       end;
  231.  
  232.  #72,#73,#80,#81,#59..#68:
  233.   begin
  234.    InputStatus:=Ord(Ext);
  235.    Exit:=True;
  236.   end;
  237.  
  238.  end; {Case of EXT }
  239. end; { if not normal char }
  240.  
  241. until Exit;
  242. Input:=S;
  243. end;
  244.  
  245. BEGIN
  246.  Write('Enter Your Name: ');
  247.  S:=Input(WhereX,WhereY,'KLoPPeR','░','',35,-1,[#32..#175],True,IS);
  248.  WriteLn;
  249.  WriteLn('Hello '+S+', have a nice day today!');
  250. END.
  251.